home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / A-B / Alpha.5.05.cpt / procs.tcl < prev    next >
Text File  |  1992-09-06  |  25KB  |  1,108 lines
  1.  
  2. # 'pete' is used in the rest of the file to determine if this is we
  3. # are sitting on someone else's disk.
  4. set pete [expr [file exists "External:C:Alpha:Alpha"]?1:0]
  5. set Tcl [expr {$pete ? {External:C:Tcl 6.2} : "$HOME"}]
  6.  
  7. #===============================================================================================
  8. # Appends all the 'noGlobNecessary' elements with globs of 'globNecessary' elements to create
  9. # the penultimate list file sets. Also calls Alpha and tells it the new list of file set names.
  10. # It is easy to create large filesets by using the 'glob' Tcl command. All that is really 
  11. # necessary is to provide Alpha with a list of fileset names and a way to retrieve the contents
  12. # of a given fileset.
  13. #===============================================================================================
  14.  
  15. if ($pete) {
  16.     set globNecessary {
  17.         {MIncludes "External:C:THINK C 5.0 Folder:Mac #includes:Apple #includes:*.h"}
  18.         {Edit "$HOME:EditSource:*.c"}}
  19.     
  20.     set noGlobNecessary { 
  21.         { Alpha 
  22.             "$HOME:EditSource:emacs.c"
  23.             "$HOME:EditSource:dir.c"
  24.             "$HOME:EditSource:alloca.c"
  25.             "$HOME:EditSource:bindings.c"
  26.             "$HOME:EditSource:command.c"
  27.             "$HOME:EditSource:file_set.c"
  28.             "$HOME:EditSource:search.c"
  29.             "$HOME:EditSource:text.c"
  30.             "$HOME:EditSource:undo.c"
  31.             "$HOME:EditSource:varargs.c"
  32.             "$HOME:EditSource:windows.c"
  33.             "$HOME:EditSource:dirT.c"
  34.             "$HOME:EditSource:frills.c"
  35.             "$HOME:EditSource:io.c"
  36.             "$HOME:EditSource:key.c"
  37.             "$HOME:EditSource:localTcl.c"
  38.             "$HOME:EditSource:moreTcl.c"
  39.             "$HOME:EditSource:shell.c"
  40.             "$HOME:EditSource:main.c"
  41.             "$HOME:EditSource:misc.c"
  42.             "$HOME:EditSource:options.c"
  43.             "$HOME:EditSource:port.c"
  44.             "$HOME:EditSource:redraw.c"
  45.             "$HOME:EditSource:alfRegexp.c"
  46.             "$HOME:EditSource:wmanager.c"
  47.             "$Tcl:panic.c"
  48.             "$Tcl:tclMac.c"
  49.             "$Tcl:tclMacUtil.c"
  50.             "$Tcl:tclAssem.c"
  51.             "$Tcl:tclBasic.c"
  52.             "$Tcl:tclCkalloc.c"
  53.             "$Tcl:tclCmdAH.c"
  54.             "$Tcl:tclCmdIL.c"
  55.             "$Tcl:tclCmdMZ.c"
  56.             "$Tcl:tclEnv.c"
  57.             "$Tcl:tclExpr.c"
  58.             "$Tcl:tclGet.c"
  59.             "$Tcl:tclGlob.c"
  60.             "$Tcl:tclHash.c"
  61.             "$Tcl:tclHistory.c"
  62.             "$Tcl:tclParse.c"
  63.             "$Tcl:tclProc.c"
  64.             "$Tcl:tclUnixAZ.c"
  65.             "$Tcl:tclUnixStr.c"
  66.             "$Tcl:tclUnixUtil.c"
  67.             "$Tcl:tclUtil.c"
  68.             "$Tcl:tclVar.c"
  69.         }
  70.     }
  71. } else {
  72.     set globNecessary {
  73.         {HomeDir "$HOME:*"}
  74.         {Help "$HOME:Help:*"}
  75.     }
  76.     
  77.     set noGlobNecessary {
  78.         { AlternateHome
  79.             "$HOME:AlphaBits.tcl"
  80.             "$HOME:procs.tcl"}
  81.         { AlternateHelp
  82.             "Alpha Help"
  83.             "Alpha Tcl Extensions"
  84.             "Debugging"
  85.             "keyboard.tex"
  86.             "LaTeX Keys"
  87.             "Regular Expressions"
  88.             "Shells"
  89.             "Tcl"
  90.             "Tickle"
  91.         }
  92.     }
  93. }
  94.  
  95.  
  96. # This list takes a string and returns the string w/ all occurances
  97. # of the variable 'HOME' substituted. To work this trick w/ other 
  98. # variables, just declare them as global in the following.
  99. # This routine creates the final fileset list from 'globNecessary' 
  100. # 'noGlobNecessary'. Typically only run at startup.
  101. proc expandFileSets {} {
  102.     global fileSets
  103.     global globNecessary
  104.     global noGlobNecessary
  105.     
  106.     uplevel #0 {set globNecessary [substituteVars $globNecessary]}
  107.     uplevel #0 {set noGlobNecessary [substituteVars $noGlobNecessary]}
  108.  
  109.     set fileSets { }
  110.     
  111.     set name [getVar currFileSet]
  112.     foreach item $globNecessary {
  113.         lappend fileSets [linsert [glob [lindex $item 1]] 0 [lindex $item 0]]
  114.         lappend names [lindex $item 0]
  115.     }
  116.     foreach item $noGlobNecessary {
  117.         lappend fileSets $item
  118.         lappend names [lindex $item 0]
  119.     }
  120.     
  121.     eval [linsert $names 0 setFSets ]
  122. }
  123. if {[catch expandFileSets]} {alertnote "Fileset expansion went wrong."}
  124.  
  125. # Called from Alpha to get list of files for current file set.
  126. proc getCurrFileSet {} {
  127.     global fileSets
  128.     set name [getVar currFileSet]
  129.     foreach set $fileSets {
  130.         if {$name == [lindex $set 0]} {
  131.             return [lrange $set 1 end]
  132.         }
  133.     }
  134.     error "Unable to find valid file set!"
  135. }
  136.  
  137.  
  138. #=============================================================================
  139. # "Electric" C functions.
  140. #=============================================================================
  141.  
  142. # First, define macros to bypass the electric braces.
  143. proc ordLeftBrace {} {
  144.     insertText "\{"
  145. }
  146. bind {'['} <cs> ordLeftBrace
  147.  
  148. proc ordRightBrace {} {
  149.     insertText "\}"
  150.     blink [matchIt "\}" [expr [getPos]-1]]
  151. }
  152. bind {']'} <cs> ordRightBrace
  153.     
  154.  
  155. # returns the indent string of the line named by 'pos'
  156. proc indentString pos {
  157.     set start [lineStart $pos]
  158.     set end [nextLineStart $pos]
  159.     set text [getText $start $end]
  160.     for {set i 0} {1} {incr i} {
  161.         set c [string index $text $i]
  162.         if {($c != "\ ") && ($c != "\t")} then {
  163.             return [string range $text 0 [expr $i-1]]
  164.         }
  165.     }
  166.     return
  167. }
  168.  
  169.  
  170. # Assumes before/after match, we start with a depth of 1. Only searches 1000
  171. # chars.
  172. proc matchIt {brace pos} {
  173.     global depth
  174.     case $brace in {
  175.         "\{" {set match "\}"; set for 1}
  176.         "\}" {set match "\{"; set for 0}
  177.         "\[" {set match "\]"; set for 1}
  178.         "\]" {set match "\]"; set for 0}
  179.         "\(" {set match "\)"; set for 1}
  180.         "\)" {set match "\("; set for 0}
  181.         default {
  182.             beep
  183.             message "Can't match '" $brace "'"
  184.         }
  185.     }
  186.  
  187.     if {$for == 1} then {
  188.         setVar forward 1;
  189.         set add 1;
  190.         set end [expr [getPos]+1000]
  191.         if {$end > [maxPos]} {set end [maxPos]}
  192.     } else {
  193.         setVar forward 0;
  194.         set add -1;
  195.         set end [expr [getPos]-1000]
  196.         if {$end < -1} {set end -1;}
  197.     }
  198.  
  199.     set depth 1
  200.     set str "($brace|$match)"
  201.     setVar regExpr 1
  202.     setVar matchWords 0
  203.     while {1} {
  204.         if {[catch {search $str $pos $end} limits] != 0}  {
  205.             message "Not matched 1"
  206.             beep
  207.             return
  208.         }
  209.         set pos [lindex $limits 0]
  210.         set c [lookAt $pos]
  211.  
  212.         if {$c == $brace} {
  213.             incr depth
  214.         } 
  215.         if {$c == $match} {
  216.             if {[set depth [expr $depth-1]] == 0} {
  217.                 return $pos
  218.             }
  219.         }
  220.         set pos [expr $pos+$add]
  221.     }
  222. }
  223.  
  224.  
  225. # Brace on new line, same indentation. Insert on another new line, indented in.
  226. # First, see if we are on new line.
  227. proc electricCLeft {} {
  228.     deleteText [getPos] [selEnd]
  229.     if {[getVar elecLBrace] == "0"} then {
  230.         insertText "\{"
  231.         return
  232.     }
  233.     set pos [getPos]
  234.     set start [lineStart $pos]
  235.     set text [getText $start $pos]
  236.     
  237.     for {set i $start} {$i < $pos} {incr i} {
  238.         set c [lookAt $i]
  239.         if {($c != "\ ") && ($c != "\t")} then {
  240.             set indentation [getText $start $i]
  241.             insertText "\r" $indentation "\{\r" $indentation "\t"
  242.             return
  243.         }
  244.     }
  245.     set indentation [getText $start $pos]
  246.     insertText "\{\r" $indentation "\t"
  247. }
  248. bind '\{' <s> electricCLeft
  249.  
  250.  
  251. # Brace on new line, immediate carriage return
  252. proc electricCRight {} {
  253.     deleteText [getPos] [selEnd]
  254.     if {[getVar elecRBrace] == "0"} then {
  255.         insertText "\}"
  256.         blink [matchIt "\}" [expr [getPos]-2]]
  257.         return
  258.     }
  259.     set pos [getPos]
  260.     set start [lineStart $pos]
  261.     set text [getText $start $pos]
  262.     
  263.     for {set i $start} {$i < $pos} {incr i} {
  264.         set c [lookAt $i]
  265.         if {($c != "\ ") && ($c != "\t")} then {
  266.             set indentation [getText $start [expr $i-1]]
  267.             insertText "\r" $indentation "\}\r" $indentation
  268.             blink [matchIt "\}" [expr $pos-1]]
  269.             return
  270.         }
  271.     }
  272.     if {$start == $pos} {
  273.         set indentation ""
  274.     } else {
  275.         set indentation [getText $start [expr $i-1]]
  276.     }
  277.     deleteText $start $pos
  278.     insertText $indentation "\}\r" $indentation
  279.     blink [matchIt "\}" [expr $start-2]]
  280. }
  281. bind '\}' <s> electricCRight
  282.  
  283.  
  284. # Brace on new line, immediate carriage return. We don't do our electric stuff
  285. # if we are in the middle of a for statement.
  286. proc electricCSemi {} {
  287.     deleteText [getPos] [selEnd]
  288.     if {[getVar electricSemi] == "0"} then {
  289.         insertText ";"
  290.         return
  291.     }
  292.     set pos [getPos]
  293.     set start [lineStart $pos]
  294.     set text [getText $start $pos]
  295.     
  296.     if {[string first "for" $text] != "-1"} {
  297.         set lefts 0
  298.         set rights 0
  299.         set len [string length $text]
  300.         for {set i 0} {$i < $len} {incr i} {
  301.             case [string index $text $i] in {
  302.                 "("    { incr lefts }
  303.                 ")"    { incr rights }
  304.             }
  305.         }
  306.         global globs
  307.         set globs [list $lefts $rights $len]
  308.         if {$lefts != $rights} {
  309.             insertText ";"
  310.             return
  311.         }
  312.     }
  313.     
  314.     insertText ";\r" [indentString $pos]
  315. }
  316. bind '\;' electricCSemi
  317.  
  318. #==============================================================================
  319. proc normalLeftBracket {} {
  320.     insertText "\{"
  321. }
  322. proc normalRightBracket {} {
  323.     insertText "\}"
  324. }
  325. bind '\[' <zs>  normalLeftBracket
  326. bind '\]' <zs>  normalRightBracket
  327. #==============================================================================
  328.  
  329.             
  330. # Select the next or current word. If word already selected, will go to next.
  331. proc hiliteWord {} {
  332.     forwardChar
  333.     forwardWord
  334.     set start [getPos]
  335.     backwardWord
  336.     select $start [getPos]
  337. }
  338.  
  339. bind 'h' <z> hiliteWord
  340.  
  341. # ================================================================================
  342. # Simple mark stack implementation
  343. # ================================================================================
  344. set markName 0
  345. set markStack ""
  346.  
  347.  
  348. proc pushMark {} {
  349.     global markStack
  350.     global markName
  351.     
  352.     set name mark$markName
  353.     incr markName
  354.     createTMark $name [getPos]
  355.     set fileName [lindex [winNames] 0]
  356.     set markStack [linsert $markStack 0 [list $fileName $name]]
  357.     message "Mark Pushed"
  358. }
  359.  
  360. proc popMark {} {
  361.     global markStack
  362.     if {[llength $markStack] == "0"} {
  363.         alertnote "The mark stack is empty!"
  364.         return
  365.     }
  366.     set mark [lindex [lindex $markStack 0] 1]
  367.     set markStack [lreplace $markStack 0 0]
  368.     gotoTMark $mark
  369.     message "Mark Popped"
  370. }
  371.  
  372.     
  373. # Returns 'list' minus all top-level elements matching 'pat'.
  374. # Used in 'closeHooks' to prune the mark stack.
  375. proc removePat {list pat} {
  376.     while 1 {
  377.         set ind [lsearch $list $pat]
  378.         if {$ind == "-1"} {return $list}
  379.         set list [lreplace $list $ind $ind]
  380.     }
  381. }
  382.  
  383.  
  384.  
  385. #=============================================================================
  386. # Hook procs recognized: "openHook", "closeHook", "activateHook", "deactivateHook", 
  387. #                          "suspendHook", and "resumeHook".
  388. #=============================================================================
  389.  
  390. # Suffix hooks - set specific modes when files opened.
  391. proc openHook name {
  392.     activateHook $name
  393. }
  394.  
  395. # Clean up the mark stack.
  396. proc closeHook name {
  397.     global markStack
  398.     set markStack [removePat $markStack $name*]
  399. }
  400.  
  401. proc activateHook name {
  402.     case $name in {
  403.         "*.c"         setCMode
  404.         "*.h"         setCMode
  405.         "*.f"          setFortranMode
  406.         "*.tcl"     setTclMode
  407.         {*tcl\ sh*}    setShellMode
  408.         "*.tex"        setTexMode
  409.         default        setTextMode
  410.     }
  411. }
  412.  
  413. proc deactivateHook name {
  414. }
  415.  
  416. proc suspendHook name {
  417. }
  418.  
  419. proc resumeHook name {
  420. }
  421.  
  422.  
  423. #=============================================================================
  424. # Load LaTeX definitions
  425. #=============================================================================
  426.  
  427. # Comment this line out if you want to use LaTeX macros.
  428. set lastMode 0
  429. set usingLatex 1
  430. if {$usingLatex} {source "$HOME:latex.tcl"}
  431.  
  432. # rta  Creating texWasLast variable
  433. set texWasLast 0
  434. # rta Following changed from ThinkC to MPW
  435. proc switchToMPW {} {
  436.     switchTo {MPW Shell}
  437. }
  438.  
  439. # Modes
  440.  
  441. # 'C' programming mode 
  442. proc setCMode {} {
  443.     global modeItemNum
  444.     changeMode "C"
  445.     insertMenu "C"
  446.     setVar elecLBrace 1
  447.     setVar elecRBrace 1
  448.     setVar electricSemi 1
  449.     setVar wordWrap 0
  450.     setVar funcExpr {^[^ \t\(#\r/@].*\(.*\)$}
  451.     setVar sortedIsDefault 1
  452.     setVar funcTitle "Func"
  453.     hiliteMenuItem Misc $modeItemNum on
  454.     set modeItemNum 7
  455.     hiliteMenuItem Misc $modeItemNum off
  456. }
  457.  
  458.  
  459. # Fortran programming mode 
  460. proc setFortranMode {} {
  461.     global modeItemNum
  462.  
  463.     changeMode "Fort"
  464.     setVar elecLBrace 0
  465.     setVar elecRBrace 0
  466.     setVar electricSemi 0
  467.     setVar wordWrap 0
  468.     setVar funcExpr {^(      |\t)(subroutine|function|SUBROUTINE|FUNCTION).*\([^\r]*\)$}
  469.     setVar sortedIsDefault 0
  470.     setVar funcTitle "Func"
  471.     hiliteMenuItem Misc $modeItemNum on
  472.     set modeItemNum 8
  473.     hiliteMenuItem Misc $modeItemNum off
  474. }
  475.  
  476.  
  477. # Alpha TCL programming mode
  478. proc setTclMode {} {
  479.     global texWasLast
  480.     global modeItemNum
  481.  
  482.     changeMode "Tcl"
  483.     setVar elecLBrace 0
  484.     setVar elecRBrace 0
  485.     setVar electricSemi 0
  486.     setVar wordWrap 0
  487.     setVar funcTitle "Proc"
  488.     setVar funcExpr {^proc *([a-zA-Z0-9-]*)}
  489.     setVar funcPar 1
  490.     setVar sortedIsDefault 1
  491.     hiliteMenuItem Misc $modeItemNum on
  492.     set modeItemNum 10
  493.     hiliteMenuItem Misc $modeItemNum off
  494. }
  495.  
  496.  
  497. # Only for the shell.
  498. proc setShellMode {} {
  499.     setTclMode
  500.     global modeItemNum
  501.     hiliteMenuItem Misc $modeItemNum on
  502.     set modeItemNum 9
  503.     hiliteMenuItem Misc $modeItemNum off
  504.     changeMode Csh
  505. }
  506.  
  507. proc switchToOztex {} {
  508.     switchTo {OzTeX}
  509. }
  510.  
  511. # LaTeX mode
  512. proc setTexMode {} {
  513.  
  514.     global modeItemNum
  515.     global usingLatex
  516.  
  517.     changeMode "Tex"
  518.     setVar elecLBrace 0
  519.     setVar elecRBrace 0
  520.     setVar electricSemi 0
  521.     setVar wordWrap 1
  522.     setVar fillColumn 75
  523.     set prefixString "% "
  524.     bind '0x79' nextSection
  525.     bind '0x74' prevSection
  526.     setVar funcTitle "Sect"
  527.     setVar sortedIsDefault 0
  528.     setVar funcExpr {^\\(sub)*section{(.*)}$}
  529.     setVar funcPar 2
  530.     hiliteMenuItem Misc $modeItemNum on
  531.     set modeItemNum 11
  532.     hiliteMenuItem Misc $modeItemNum off
  533.     if {$usingLatex} {
  534.         setVar optionIsMeta 0
  535.         bindTexKeys
  536.         insertMenu "LaTeX"
  537.     }
  538. }
  539.  
  540.  
  541.  
  542. # Ordinary, default mode
  543. proc setTextMode {} {
  544.     global modeItemNum
  545.  
  546.     changeMode "Text"
  547.     setVar elecLBrace 0
  548.     setVar elecRBrace 0
  549.     setVar electricSemi 0
  550.     setVar wordWrap 1
  551.     setVar fillColumn 75
  552.     set prefixString "> "
  553.     set suffixString " <--"
  554.     hiliteMenuItem Misc $modeItemNum on
  555.     set modeItemNum 12
  556.     hiliteMenuItem Misc $modeItemNum off
  557. }
  558.  
  559. proc changeMode {newMode} {
  560.     global lastMode
  561.     if {$lastMode == $newMode} {
  562.         displayMode $newMode
  563.         return
  564.     }
  565.     
  566.     if {$lastMode == "Tex"} then {
  567.         global usingLatex
  568.         if {$usingLatex} then {
  569.             removeMenu "LaTeX"
  570.             setVar optionIsMeta 1
  571.             unbindTexKeys
  572.         }
  573.     } else {
  574.         if {$lastMode == "C"} {
  575.             removeMenu "C"
  576.         }
  577.     }
  578.  
  579.     global mode
  580.     set mode $newMode
  581.     displayMode $newMode
  582.     set lastMode $newMode
  583. }
  584.     
  585.  
  586. proc unsetTexMode {} {
  587.     global texWasLast
  588.     global usingLatex
  589.     if {$usingLatex} {
  590.         removeMenu "LaTeX"
  591.         setVar optionIsMeta 1
  592.         unbindTexKeys
  593.     }
  594.     set texWasLast 0
  595. }
  596.  
  597.  
  598. #=============================================================================
  599. # 'Strings' commands
  600. #=============================================================================
  601. set prefixString ">\ "
  602. set suffixString "\ <--"
  603.  
  604. proc insertSuffix {} {doSuffix insert}
  605. proc removeSuffix {} {doSuffix remove}
  606. proc doSuffix {which} {
  607.     global suffixString
  608.     set str ${suffixString}\r
  609.     set start [getPos]
  610.     set end [selEnd]
  611.     set start [lineStart $start]
  612.     set end [nextLineStart [expr $end-1]]
  613.     set text [getText $start $end]
  614.     deleteText $start $end
  615.     if {$which == "insert"} then {
  616.         regsub -all \r $text $str text
  617.     } else {
  618.         regsub -all $str $text \r text
  619.     }
  620.     insertText $text
  621. }
  622.  
  623.  
  624. proc insertPrefix {} {doPrefix insert}
  625. proc removePrefix {} {doPrefix remove}
  626. proc doPrefix {which} {
  627.     global prefixString
  628.     set str \r$prefixString
  629.     set start [getPos]
  630.     set end [expr [selEnd]-1]
  631.     if {$end<$start} {set end $start}
  632.     set start [lineStart $start]
  633.     set text [getText $start $end]
  634.     deleteText $start $end
  635.     if {$which == "insert"} then {
  636.         regsub -all \r $text $str text
  637.         insertText $prefixString $text 
  638.     } else {
  639.         regsub -all $str $text \r text
  640.         regsub ^$prefixString $text "" text
  641.         insertText $text
  642.     }
  643. }
  644.  
  645.  
  646. #=============================================================================
  647. #    Named Clipboards
  648. #=============================================================================
  649.  
  650. proc copyNamedClipboard {} {
  651.     global clipBoards
  652.     global pasteItemNum
  653.     hiliteMenuItem Misc $pasteItemNum on
  654.     set text [getText [getPos] [selEnd]]
  655.     set name [prompt {Clip name?} [lindex $text 0]]
  656.     if {![string length $name]} then {
  657.         beep
  658.     } else {
  659.         set clipBoards($name) $text
  660.     }
  661. }
  662.  
  663. proc cutNamedClipboard {} {
  664.     global clipBoards
  665.     global pasteItemNum
  666.     hiliteMenuItem Misc $pasteItemNum on
  667.     set text [getText [getPos] [selEnd]]
  668.     deleteText [getText [getPos] [selEnd]]
  669.     set name [prompt {Clip name?} [lindex $text 0]]
  670.     if {![string length $name]} then {
  671.         beep
  672.     } else {
  673.         set clipBoards($name) $text
  674.     }
  675. }
  676.  
  677. proc pasteNamedClipboard {} {
  678.     global clipBoards
  679.     set name [eval [concat {prompt {Clip name?} "" Clips} [array names clipBoards]]]
  680.     if {[catch {set text $clipBoards($name)}] == 0}    {
  681.         insertText $text
  682.     } else {
  683.         alertnote "Unable to find that clipboard"
  684.     }
  685. }
  686.  
  687.  
  688. # Looks for definition of clipboard named 'name'.
  689. proc lookForClip {name} {
  690.     global clipBoards
  691.     set len = 2
  692.     for {set i 0} {$i < $len} {incr i} {
  693.         if {[lindex $clip 0] == $name} {
  694.             return [lindex $clip 2]
  695.         }
  696.     }
  697.     return ""
  698. }
  699.  
  700.  
  701. #=============================================================================
  702. #    Shell Aliases
  703. #=============================================================================
  704. proc l {args} {
  705.     eval [concat "ls -F" $args]}
  706.  
  707. proc ll {args} {
  708.     eval [concat "ls -l" $args]}
  709.  
  710.  
  711. proc grep {pat args} {
  712.     insertText "\r"
  713.     set pat *$pat*
  714.     set args [glob -nocomplain $args]
  715.     foreach file $args {
  716.         set id [open $file]
  717.         while {[gets $id string] != "-1"} {
  718.             if {[string match $pat $string] == 1} {
  719.                 insertText $file: $string "\r"
  720.             }
  721.         }
  722.         close $id
  723.     }
  724. }
  725.  
  726.  
  727. proc alphaHelp {} {
  728.     global HOME
  729.     edit "$HOME:Help:Alpha Help" readonly
  730. }
  731.  
  732.  
  733. #=============================================================================
  734. #    'Fill' routines.
  735. #=============================================================================
  736.  
  737. proc fillParagraph {} {
  738.     set pos [getPos]
  739.     set start [paraStart $pos] 
  740.     set finish [paraFinish $pos]
  741.     goto $start
  742.     set text [fillText $start $finish]
  743.     replaceText $start $finish $text "\r"
  744. }
  745.  
  746. proc fillRegion {} {
  747.     set start [getPos]
  748.     set finish [selEnd]
  749.     goto $start
  750.     set text [fillText $start $finish]
  751.     replaceText $start $finish $text "\r"
  752. }
  753.     
  754. proc wrapParagraph {} {
  755.     set pos [getPos]
  756.     set start [paraStart $pos] 
  757.     set finish [paraFinish $pos]
  758.     goto $start
  759.     wrapText $start $finish
  760. }
  761.  
  762. proc wrapRegion {} {
  763.     set start [getPos]
  764.     set finish [selEnd]
  765.     if {$start == $finish} {
  766.         set finish [maxPos]
  767.     }
  768.     wrapText $start $finish
  769. }
  770.     
  771. proc paraStart {pos} {
  772.     while {$pos > 0} {
  773.         set pos [lineStart $pos]
  774.         if {[lookAt [expr $pos-2]] == "\r"} {return $pos}
  775.         set pos [expr $pos-1]
  776.     }
  777.     return 0
  778. }
  779.  
  780.  
  781. proc paraFinish {pos} {
  782.     set end [maxPos]
  783.     while {$pos < $end} {
  784.         set pos [nextLineStart $pos]
  785.         if {$pos == "-1"} {return $end}
  786.         if {[lookAt $pos] == "\r"} {return $pos}
  787.     }
  788.     return $end
  789. }
  790.  
  791.  
  792. # Remove text from window, transform, and insert back into window.
  793. proc fillText {from to} {
  794. # Get The text
  795.     set text [getText $from $to]
  796.     
  797. # Remove duplicated white space, carriage returns.
  798.     regsub -all "\[ \t\r\]+" $text " " text
  799.  
  800. # Insert left margins and carriage returns, doesn't end with a carriage return.
  801.     return [breakIntoLines $text]
  802. }
  803.  
  804. #=============================================================================
  805. #    Window handling routines.
  806. #=============================================================================
  807. proc shrinkHigh {} {
  808.     set text [getGeometry]
  809.     set left [lindex $text 0]
  810.     set top [lindex $text 1]
  811.     set width [lindex $text 2]
  812.     sizeWin $width 150
  813.     moveWin $left 42 
  814. }
  815.  
  816. proc shrinkLow {} {
  817.     set text [getGeometry]
  818.     set left [lindex $text 0]
  819.     set top [lindex $text 1]
  820.     set width [lindex $text 2]
  821.     moveWin $left 330
  822.     sizeWin $width 146
  823. }
  824.  
  825.  
  826. proc nextWindow {} {
  827.     set files [winNames]
  828.     if {[llength $files] <= 1} return
  829.     sendToBack [lindex $files 0]
  830. }
  831.  
  832. proc prevWindow {} {
  833.     set files [winNames]
  834.     set len [llength $files]
  835.     if {$len <= 1} return
  836.     bringToFront [lindex $files [expr $len-1]]
  837. }
  838.  
  839. proc vertically {} {
  840.     set margin 22
  841.     set names [winNames]
  842.     set numWins [llength $names]
  843.     if ($numWins<=1) return
  844.     set height [expr ([getVar defHeight]/$numWins)-$margin]
  845.     set width 640
  846.     set ver 40
  847.     if {$numWins == 0} {return}
  848.  
  849.     for {set i 0} {$i < $numWins} {incr i} {
  850.         moveWin [lindex $names $i] 1000 0
  851.     }
  852.  
  853.     for {set i 0} {$i < $numWins} {incr i} {
  854.         sizeWin [lindex $names $i] $width $height
  855.         moveWin [lindex $names $i] 3 $ver
  856.         set ver [expr $ver+$margin+$height]
  857.     }
  858. }
  859.  
  860. proc horizontally {} {
  861.     set names [winNames]
  862.     set numWins [llength $names]
  863.     if ($numWins<=1) return
  864.     set margin 4
  865.     set width [expr (640/$numWins)-$margin]
  866.     set height [getVar defHeight]
  867.     set hor 0
  868.     if {$numWins == 0} {return}
  869.  
  870.     for {set i 0} {$i < $numWins} {incr i} {
  871.         moveWin [lindex $names $i] 1000 0
  872.         sizeWin [lindex $names $i] $width $height
  873.     }
  874.  
  875.     for {set i 0} {$i < $numWins} {incr i} {
  876.         moveWin [lindex $names $i] $hor 40
  877.         set hor [expr $hor+$width+$margin]
  878.     }
  879. }
  880.  
  881. proc tiled {} {
  882.         set xPan 8
  883.         set yPan 10
  884.         set xMarg 3
  885.         set yMarg 40
  886.         set yMax 50
  887.  
  888.         set names [winNames]
  889.         set numWins [llength $names]
  890.         if ($numWins<1) return
  891.         set line 0
  892.  
  893.         set height [expr [getVar defHeight]-$yPan*($numWins-1)]
  894.         set width [getVar defWidth]
  895.         
  896.         for {set i 0} {$i < $numWins} {incr i} {
  897.                 moveWin [lindex $names $i] [expr $xMarg+$i*$xPan] [expr $yMarg+\
  898. $line]
  899.                 set line [expr $line+$yPan]
  900.                 if ($line>$yMax) {set line 0}
  901.                 sizeWin [lindex $names $i] $width $height
  902.         }
  903. }
  904.  
  905.  
  906. proc overlay {} {
  907.         set names [winNames]
  908.         set numWins [llength $names]
  909.         if ($numWins<1) return
  910.         for {set i 0} {$i < $numWins} {incr i} {
  911.                 moveWin [lindex $names $i] 3 40
  912.                 sizeWin [lindex $names $i] [getVar defWidth] [getVar defHeight]
  913.         }
  914. }
  915.             
  916.  
  917. #=============================================================================
  918. # Template editing, just an example.  To use, load this file, hit
  919. # control-i, and a for template will appear. Consecutive control-j's
  920. # will step you though various fields of the for statement. 
  921. #=============================================================================
  922.  
  923. # C 'for' template
  924.  
  925. menu C {
  926.     "forTemplate"
  927.     "whileTemplate"
  928.     "(-"
  929.     "/\\nextStop"
  930.     "(-"
  931.     "findTag"
  932.     "createTagFile"}
  933.  
  934. proc forTemplate {} {
  935.     indentLine
  936.     set pos [getPos]
  937.     set indent [indentString $pos]
  938.     set str1 "for (\;\;)\r"
  939.     set str2 "\{\r"
  940.     set str3 "\t\r"
  941.     set str4 "\}\r"
  942.  
  943.     insertText $str1 $indent $str2 $indent $str3 $indent $str4 $indent
  944.     set len [string length $indent]
  945.     
  946.     createTMark stop1 [expr $pos+5]
  947.     createTMark stop2 [expr $pos+6]
  948.     createTMark stop3 [expr $pos+7]
  949.     set temp4 [expr { $pos + [string length $str1] + [string length $str2] +
  950.                              [string length $str3] + 2 * $len - 1}]
  951.     createTMark stop4 $temp4
  952.     createTMark stop5 [expr { $temp4 + 2 * [string length $str4] + $len}]
  953.     
  954.     global stopRing
  955.     set stopRing "stop1 stop2 stop3 stop4 stop5"
  956.     gotoTMark stop1
  957.     bind 'j' <z> nextStop
  958. }
  959.  
  960. proc whileTemplate {} {
  961.     indentLine
  962.     set pos [getPos]
  963.     set indent [indentString $pos]
  964.     set str1 "while ()\r"
  965.     set str2 "\{\r"
  966.     set str3 "\t\r"
  967.     set str4 "\}\r"
  968.  
  969.     insertText $str1 $indent $str2 $indent $str3 $indent $str4 $indent
  970.     set len [string length $indent]
  971.     
  972.     createTMark stop1 [expr $pos+7]
  973.     set temp [expr { $pos + [string length $str1] + [string length $str2] +
  974.                              [string length $str3] + 2 * $len - 1}]
  975.     createTMark stop2 $temp
  976.     createTMark stop3 [expr { $temp + 2 * [string length $str4] + $len}]
  977.     
  978.     global stopRing
  979.     set stopRing "stop1 stop2 stop3"
  980.     gotoTMark stop1
  981.     bind 'j' <z> nextStop
  982. }
  983.  
  984. proc nextStop {} {
  985.     global stopRing
  986.     set first [lindex $stopRing 0]
  987.     set stopRing [lreplace $stopRing 0 0]
  988.     set stopRing [lappend stopRing $first]
  989.     gotoTMark [lindex $stopRing 0]
  990. }
  991.  
  992.  
  993.  
  994. #=============================================================================
  995. # Random functions.
  996. #=============================================================================
  997. proc lineToParagraph {} {
  998.     saveVars
  999.     setVar fillColumn 10000
  1000.     setVar leftFillColumn 0
  1001.     fillRegion
  1002.     restoreVars}
  1003.  
  1004. proc paragraphToLine {} {
  1005.     saveVars
  1006.     setVar fillColumn 75
  1007.     setVar leftFillColumn 0
  1008.     fillRegion
  1009.     restoreVars}
  1010.  
  1011. proc commentBox {} {
  1012.     alertnote "I haven't gotten around to this yet." }
  1013.  
  1014. proc uncommentBox {} {
  1015.         alertnote "I haven't gotten around to this yet." }
  1016.  
  1017. proc transposeChars {} {
  1018.         alertnote "I haven't gotten around to this yet." }
  1019.  
  1020. proc transposeWords {} {
  1021.         alertnote "I haven't gotten around to this yet." }
  1022.  
  1023.  
  1024. proc nextFunc {} {
  1025.     searchFunc 1
  1026. }
  1027.  
  1028. proc prevFunc {} {
  1029.     searchFunc 0
  1030. }
  1031.  
  1032. proc searchFunc {dir} {
  1033.     select [getPos]
  1034.     saveVars
  1035.     if ($dir==1) {
  1036.         nextLine
  1037.     } else {
  1038.         previousLine
  1039.     }
  1040.     set pos [getPos]
  1041.     setVar regExpr 1
  1042.     setVar forward $dir
  1043.     setVar ignoreCase 1
  1044.     eval select [search {^[^ \t\(#\r/@].*\(.*\)$} $pos]
  1045.     restoreVars
  1046. }
  1047.  
  1048.  
  1049. # Shell history commands.
  1050. source "$HOME:shell.tcl"
  1051.  
  1052. #===========================================================================
  1053. # Include file manipulation. - called from Alpha.
  1054. #===========================================================================
  1055. proc includeFile {} {
  1056.     global includePath
  1057.     global Think
  1058.     set path [substituteVars $includePath]
  1059.     set fname [getSelect]
  1060.     if {[string last ".h" $fname]=="-1"} {
  1061.         set fname ${fname}.h
  1062.     }
  1063.     foreach dir $path {
  1064.         if {[file exists $dir$fname]} {
  1065.             edit $dir$fname
  1066.             return
  1067.         }
  1068.     }
  1069.     beep
  1070. }
  1071. #===========================================================================
  1072. # Add temporary fileset.
  1073. #===========================================================================
  1074. set firstTemp 1
  1075. proc addFileset {} {
  1076.     global fileSets
  1077.     global firstTemp
  1078.     
  1079.     if {$firstTemp == 1} {
  1080.         if {[askyesno "This routine is flakey. Continue?"] != "yes"} return
  1081.         set firstTemp 0
  1082.     }
  1083.     set name [getline "New fileset name:" ""]
  1084.     if {![string length $name]} return
  1085.     
  1086.     set dir [get_directory]
  1087.     if {![string length $dir]} return
  1088.     
  1089.     set filePat [getline "File pattern:" "*"]
  1090.     if {![string length $filePat]} return
  1091.     
  1092.     set newFSet [glob "$dir:$filePat"]
  1093.     lappend fileSets [linsert $newFSet 0 $name]
  1094.  
  1095.     set names {}
  1096.     foreach set $fileSets {
  1097.         lappend names [lindex $set 0]
  1098.     }
  1099.     eval [linsert $names 0 setFSets ]
  1100. }
  1101.  
  1102.  
  1103. #===========================================================================
  1104. # Comment routines.
  1105. #===========================================================================
  1106. proc commentPara {} {
  1107. }
  1108.